home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 16 / AMIGAplus Sonderheft 16 (1998)(ICP)(DE)[!].iso / pd / anwendungen / amicad / arexx_english / selectnet.amicad < prev    next >
Text File  |  1998-08-09  |  4KB  |  193 lines
  1. /* $VER: NetList 1.00e (© R.Florac, 09-08-98) */
  2.  
  3. options results
  4.  
  5. signal on error
  6. signal on syntax
  7.  
  8. 'FIRSTSEL'; i=result
  9. if result~=0 then do
  10.     'NEXTSEL(FIRSTSEL)'
  11.     if result~=0 then i=0
  12. end
  13.  
  14. if i=0 then do
  15.     'PICKOBJ("Click on the net to check")'
  16.     i=result
  17. end
  18.  
  19. if i=0 then exit
  20.  
  21. j=1; nets=0; net.0=""
  22. 'TITLE("Reading nets..."):LOCK(-1):OBJECTS(-1)'; objets=result
  23.  
  24. net.=-1
  25.  
  26. 'TYPE(O='i')'
  27. if result=2 then do
  28.     'UNMARK(-1):TEST(O)'
  29.     if result=0 then do
  30.     'COORDS(O)'
  31.     parse var result x0','y0','x1','y1
  32.     call test_ligne(x0,y0,objets)
  33.     call test_ligne(x1,y1,objets)
  34.     end
  35. end
  36. else do
  37.     'MESSAGE("Selection incorrect")'
  38.     exit
  39. end
  40.  
  41. 'TITLE("Test of junctions...")'
  42. m=1
  43. do while m>0
  44.     m=0
  45.     i=1
  46.     do while i>0
  47.     'OO=FINDOBJ('i',7,-1,-1)'; i=result
  48.     if i>0 then do
  49.         'TEST(OO)'
  50.         if result=0 then do
  51.         'COL(OO)'; x0=result
  52.         'LINE(OO)'; y0=result
  53.         n=test_jonction(x0,y0,objets)
  54.         if n=1 then do
  55.            'MARK(OO)'
  56.             call marquer_ligne(x0,y0,objets)
  57.             m=1
  58.         end
  59.         end
  60.         if i=objets then i=0
  61.         else i=i+1
  62.     end
  63.     end
  64. end
  65.  
  66. 'TITLE("Checking grounds...")'
  67. label=""
  68. do i=1 to objets
  69.     'O=FINDPART('i',"GROUND")'; i=result
  70.     if i>0 then do
  71.     j=connexion_broche(i,1)
  72.     if j>0 then do
  73.         'TEST('j')'
  74.         if result=1 then do
  75.         label=0
  76.         leave i
  77.         end
  78.     end
  79.     i=i+1
  80.     end
  81.     else leave
  82. end
  83.  
  84. if label="" then do
  85.     'TITLE("Looking for labels...")'
  86.     do i=1 to objets
  87.     'TYPE(O='i')'
  88.     if result=4 | result=12 | result=11 then do
  89.         'ABS(FINDLINE(1,COL(O),LINE(O)))'; j=result
  90.         if j>0 then do
  91.         'TEST('j')'
  92.         if result=1 then do
  93.             'READTEXT(O)'; label=result; leave i
  94.         end
  95.         end
  96.     end
  97.     end
  98. end
  99.  
  100. if label="" then do
  101.     'TITLE("Looking for powers...")'
  102.     do i=1 to objets
  103.     'O=FINDPART('i',"POWER SUPPLY")'; i=result
  104.     if i>0 then do
  105.         j=connexion_broche(i,1)
  106.         if j>0 then do
  107.         'TEST('j')'
  108.         if result=1 then do
  109.             'READTEXT(GETVAL(O))'; label=result; leave i
  110.         end
  111.         end
  112.         i=i+1
  113.     end
  114.     else leave
  115.     end
  116. end
  117.  
  118. 'TITLE("")'
  119. if label~="" then 'MESSAGE("Net 'label'")'
  120. exit
  121.  
  122. test_ligne: procedure expose net.
  123.     parse arg x0,y0,objets
  124.     o=1
  125.     do until o=0
  126.     'X=FINDOBJ('o',2,'x0','y0')'; o=result
  127.     if o>0 then do
  128.         'IF(TEST(X),0,MARK(X):COORDS(X))'
  129.         if result~=0 then do
  130.         net.o=1
  131.         parse var result x1','y1','x2','y2
  132.         if x0=x1 & y0=y1 then call test_ligne(x2,y2,objets)
  133.         else call test_ligne(x1,y1,objets)
  134.         end
  135.         if o=objets then return
  136.         o=o+1
  137.     end
  138.     end
  139.     return
  140.  
  141. marquer_ligne: procedure expose net.
  142.     parse arg x0,y0,objets
  143.     o=1
  144.     do until o=0
  145.     'X=ABS(FINDLINE('o','x0','y0'))'; o=result
  146.     if o>0 then do
  147.         'IF(TEST(X),0,MARK(X):COORDS(X))'
  148.         if result~=0 then do
  149.         net.o=1
  150.         parse var result xl','yl','x1','y1
  151.         call test_ligne(xl,yl,objets)
  152.         call test_ligne(x1,y1,objets)
  153.         end
  154.         if o=objets then return
  155.         o=o+1
  156.     end
  157.     end
  158.     return
  159.  
  160. test_jonction: procedure expose net.
  161.     parse arg xj,yj,objets
  162.     obj=1
  163.     do while obj>0
  164.     'X=ABS(FINDLINE('obj','xj','yj'))'; obj=result
  165.     if net.obj=1 then return 1
  166.     if obj=0 then return 0
  167.     if obj=objets then return 0
  168.     obj=obj+1
  169.     end
  170.     return 0
  171.  
  172. connexion_broche: procedure
  173.     parse arg objet,broche
  174.     'PINCOL(O='objet',B='broche')'; xj=result
  175.     'PINLINE(O,B)'; yj=result
  176.     'FINDOBJ(1,2,'xj','yj')'; xl=result
  177.     if xl>0 then return xl
  178.     'FINDLINE(1,'xj','yj')'; xl=result
  179.     if xl<=0 then return 0
  180.     'FINDOBJ(1,7,'xj','yj')'
  181.     if result>0 then return xl
  182.     return 0
  183.  
  184. syntax:
  185. erreur=RC
  186. 'MESSAGE("Script SelectNet.AmiCAD:"+CHR(10)+"Syntax error"+CHR(10)+"in line 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  187. exit
  188.  
  189. error:
  190. 'MESSAGE("Script SelectNet.AmiCAD:"+CHR(10)+"Erreur in line 'SIGL'")'
  191. exit
  192.  
  193.